home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / pencil.arc / PENCIL.BAS (.txt)
Encoding:
GW-BASIC  |  1985-09-27  |  2.6 KB  |  97 lines
  1. 10  CLEAR:SSSS=1:FAST=0:C=1:DIM Q$(1000):DIM U(1000):DIM CL(1000):ZX=18:STRIG (0) ON:STRIG (4) ON
  2. 20  SCREEN 0,0,0:WIDTH 80:COLOR 2,4,5:KEY OFF:CLS:POKE 106,0
  3. 30  FOR T=1 TO 10:KEY (T) ON:NEXT:GOSUB 100
  4. 40  SCREEN SSSS:COLOR 0,2:CLS
  5. 50  ZX=0:X=160:Y=100:T=0
  6. 60  WINDOW SCREEN (0,0)-(128,128)
  7. 65  X=STICK(0):Y=STICK(1)
  8. 70  LINE (X,Y)-(X,Y),C,BF
  9. 80  IF INKEY$="+" THEN CLS
  10. 90  GOTO 65
  11. 100  CLS:FOR T=1 TO 10:KEY(T)ON:NEXT
  12. 110  ON KEY (1) GOSUB 790
  13. 120  ON KEY (5) GOSUB 470
  14. 130  ON KEY (6) GOSUB 490
  15. 140  ON KEY (7) GOSUB 630
  16. 150  ON KEY (8) GOSUB 380
  17. 160  ON KEY (9) GOSUB 340
  18. 170  ON KEY (10) GOSUB 330
  19. 180  RETURN
  20. 190  PRINT" <F1>=PRINT THE SCREEN"
  21. 200  PRINT" <F2>=SWITCH SCREENS"
  22. 210  PRINT" <F3>=DRAW FAST/SLOW"
  23. 220  PRINT" <F4>=THICKNESS"
  24. 230  PRINT" <F5>=DRAWING COLOR"
  25. 240  PRINT" <F6>=SAVE SCREEN"
  26. 250  PRINT" <F7>=RETRIEVE PICTURE"
  27. 260  PRINT" <F8>="
  28. 270  PRINT" <F9>="
  29. 280  PRINT" <F10>="
  30. 290  SSSS=SSSS+1:IF SSSS>2 THEN SSSS=1
  31. 300  IF SSSS=1 THEN ZX=18
  32. 310  IF SSSS=2 THEN ZX=36
  33. 320  SCREEN SSSS:RETURN
  34. 330  C=0:RETURN
  35. 340  IF SSSS=1 AND TH>-1 AND SH>-1 THEN LINE (TH,SH)-(127-TH,127-SH),0,B
  36. 350  IF SSSS=2 AND TH>-1 AND SH>-1 THEN LINE (7+TH,2+SH)-(639-TH,196-SH),0,B
  37. 360  SH=SH-0.5:TH=TH-0.3
  38. 370  RETURN
  39. 380  IF SSSS=1 AND TH>-1 AND SH>-1 THEN LINE (TH,SH)-(127-TH,127-SH),C,B
  40. 390  IF SSSS=2 AND TH>-1 AND SH>-1 THEN LINE (7+TH,2+SH)-(639-TH,196-SH),C,B
  41. 400  TH=TH+0.3:SH=SH+0.5
  42. 410  IF BBBB=0 THEN CL(M)=C:Q$(M)="BC":U(M)=T:M=M+1
  43. 420  RETURN
  44. 430  IF FAST=1 THEN FAST=0:RETURN
  45. 440  IF FAST=0 THEN FAST=1:RETURN
  46. 450  T=T+2:IF T>10 THEN T=0
  47. 460  RETURN
  48. 470  C=C+1:IF C>3 THEN C=1
  49. 480  RETURN
  50. 490  N$="PEST":EN$=".TEM":GOSUB 610
  51. 500  ON ERROR GOTO 520
  52. 510  CLS:FILES "*.PIC"
  53. 520  INPUT "NAME OF FILE TO SAVE(</> TO EXIT)";N$:IF N$="/" THEN DEF SEG=&HB800:BLOAD "PEST.TEM":FLAG1=1:GOTO 110
  54. 530  FOR L=1 TO LEN (N$)
  55. 540  IF MID$(N$,L,1)="." THEN PRINT"DON'T USE A PERIOD IN THE NAME!":GOTO 520
  56. 550  NEXT
  57. 560  INPUT "SURE";S$:IF LEFT$(S$,1)="N" OR LEFT$(S$,1)="n" THEN 510
  58. 570  OPEN "A:"+N$+".VAR" FOR OUTPUT AS #1
  59. 580  PRINT #1,SSSS,FAST,C,X,Y
  60. 590  CLOSE
  61. 600  NAME "A:PEST.TEM" AS "A:"+N$+".PIC":SH=0:TH=0:X=160:Y=100:A$="":C=C+1:BBBB=0:FLAG1=1:SCREEN SSSS:GOSUB 620:GOTO 110
  62. 610  DEF SEG = &HB800:BSAVE "A:PEST.TEM",0,&H4000
  63. 620  CLS:DEF SEG = &HB800:BLOAD "A:"+N$+EN$:CLOSE:EN$=".PIC":RETURN
  64. 630  CLS
  65. 640  PRINT"PUT A DISK IN DRIVE `A' AND HIT A KEY   WHEN READY."
  66. 650  IF INKEY$="" THEN 650
  67. 660  CLS:FILES "*.PIC"
  68. 670  PRINT:INPUT "FILE TO RETRIEVE";N$
  69. 680  FOR T=1 TO LEN (N$)
  70. 690  IF MID$(N$,T,1)="." THEN PRINT"DON'T USE A PERIOD IN THE NAME!":GOTO 670
  71. 700  NEXT
  72. 710  OPEN "A:"+N$+".VAR" FOR INPUT AS #1
  73. 720  INPUT #1,SSSS,FAST,C,X,Y
  74. 730  CLOSE:SH=0:TH=0:SCREEN SSSS:CLS:DEF SEG = &HB800:BLOAD "A:"+N$+".PIC":FLAG1=1:A$="":GOTO 110
  75. 740  ZX=ZX+1:IF ZX>1 THEN ZX=0
  76. 750  RETURN
  77. 760  PR=PR+1:IF PR>1 THEN PR=0
  78. 770  RETURN
  79. 780  A$="":B$=A$:RETURN
  80. 790  LPRINT CHR$ (2);CHR$(3);
  81. 800  DIM A (10):GOTO 830
  82. 810  CLS:SCREEN 1
  83. 820  FOR S=0 TO 199 STEP 40:FOR T= 0 TO 319 STEP 30:CIRCLE (T,S),20:NEXT:NEXT
  84. 830  FOR AS=0 TO 199 STEP 7:FOR JK=0 TO 319
  85. 840  FOR GH=0 TO 6
  86. 850  A(GH)=POINT(JK,GH+AS):NEXT
  87. 860  IF A(0)<>0 THEN P=P+1
  88. 870  IF A(1)<>0 THEN P=P+2
  89. 880  IF A(2)<>0 THEN P=P+4
  90. 890  IF A(3)<>0 THEN P=P+8
  91. 900  IF A(4)<>0 THEN P=P+16
  92. 910  IF A(5)<>0 THEN P=P+32
  93. 920  IF A(6)<>0 THEN P=P+64
  94. 930  LPRINT CHR$ (P);:'CHR$ (20);
  95. 940  P=0:NEXT:LPRINT CHR$ (3);CHR$ (14);:NEXT
  96. 950  FLAG1=1:GOTO 110
  97.